REBOL [
	Title: "RebGUI widgets"
	Owner: "Ashley G Truter"
	Purpose: "The RebGUI base widget set."
]

widgets: make object! [

	;
	;	Base edge, font, para, feel & action objects
	;

	default-edge: make object! [
		color: colors/outline/3
		image: none
		effect: none
		size: 1x1
	]

	default-font: make object! [
		name: effects/font
		style: none
		size: sizes/font
		color: colors/text
		offset: 0x0
		space: 0x0
		align: 'left
		valign: 'middle
		shadow: none
	]

	default-para: make object! [
		origin: 2x2
		margin: 2x2
		indent: 0x0
		tabs: 0
		wrap?: false
		scroll: 0x0
	]

	default-feel: make object! [
		redraw:
		detect:
		over:
		engage: none
	]

	default-action: make object! [
		on-alt-click:
		on-away:
		on-click:
		on-dbl-click:
		on-edit:
		on-focus:
		on-key:
		on-over:
		on-resize:
		on-scroll:
		on-time:
		on-unfocus: none
	]

	font-button: make default-font [align: 'center]
	font-heading: make default-font [color: colors/theme/3 size: sizes/font * 2]
	font-label: make default-font [color: colors/theme/2]
	font-link: make default-font [style: 'underline color: blue]
	font-right: make default-font [align: 'right]
	font-top: make default-font [valign: 'top]

	para-wrap: make default-para [origin: 2x0 wrap?: true]
	para-indent: make default-para [origin: as-pair sizes/line 2]

	over?: make function! [face event] [
		all [
			event/offset/x < face/size/x
			event/offset/y < face/size/y
			event/offset/x >= 0
			event/offset/y >= 0
		]
	]

	feel-click: make object! [
		redraw:
		detect: none
		over: make function! [face into pos /state] [
			all [state set-state/no-show face into]
			set-color face either into [colors/theme/1] [none]
		]
		engage: make function! [face act event] [
			switch act [
				down [face/feel/over/state face on 0x0]
				up [set-state face off all [over? face event face/action/on-click face]]
				over [face/feel/over/state face on 0x0]
				away [face/feel/over/state face off 0x0]
			]
		]
	]

	;	offset
	;	size
	;	span
	;	pane
	;	text
	;	color
	;	image
	;	effect
	;	data
	;	edge
	;	font
	;	para
	;	feel
	;	rate
	;	show?
	;	options
	;	action
	;	init

	baseface: system/standard/face
	baseface/color:
	baseface/edge:
	baseface/font:
	baseface/para:
	baseface/feel: none

	gradface: make baseface [
		effect: reduce ['gradient 0x1 white colors/outline/1]
		edge: default-edge
		font: font-button
	]

	text-size?: make function! [
		"Returns default text size."
		string [string!]
	] [
		size-text make baseface [
			size: 10000x10000
			text: string
			font: default-font
		]
	]

	text-width?: make function! [
		"Returns greater of text width, specified size and line height."
		face
		/pad
		/local x
	] [
		pad: either pad [sizes/font] [0]
		x: face/size/x
		face/size/x: 10000
		max sizes/line either negative? x [pad + first size-text face] [max x pad + first size-text face]
	]

	sizes/font-height: second text-size? ""

	;
	;	--- Iterator function ---
	;

	face-iterator: make baseface [
		type: 'face-iterator
		pane: []
		data: []
		options: []
		timeout: now/time/precise
		feel: make default-feel [
			redraw: make function! [face act pos] [
				all [act = 'show face/size <> face/old-size face/resize]
			]
			engage: make function! [face act event /local i] [
				if act = 'time [
					if (now/time/precise - face/timeout) > 0:00:0.2 [
						face/action/on-click face
						face/rate: none
						show face
					]
				]
				if act = 'key [
					switch event/key [
						#"^A" [; CTRL-A
							all [
								find face/options 'multi
								clear face/picked
								repeat i face/rows [insert tail face/picked i]
								face/action/on-click face
							]
						]
						down [; DnAr
							all [empty? face/picked insert face/picked 0]
							i: 1 + last face/picked
							if i <= face/rows [
								insert clear face/picked i
								if find [table text-list tree] face/parent-face/type [
									face/timeout: now/time/precise
									face/rate: 60
									if i > (face/scroll + face/lines) [
										face/pane/2/data: 1 / (face/rows - face/lines) * ((min (face/rows - face/lines + 1) (i - face/lines + 1)) - 1)
										face/scroll: face/scroll + 1
									]
								]
							]
						]
						up [; UpAr
							all [empty? face/picked insert face/picked face/rows + 1]
							i: -1 + last face/picked
							if i > 0 [
								insert clear face/picked i
								if find [table text-list tree] face/parent-face/type [
									face/timeout: now/time/precise
									face/rate: 60
									if i = face/scroll [
										face/pane/2/data: 1 / (face/rows - face/lines) * ((min (face/rows - face/lines + 1) i) - 1)
										face/scroll: face/scroll - 1
									]
								]
							]
						]
						#"^M" [; Enter
							face/action/on-click face
						]
					]
					show face
				]
			]
		]
		lines: ; number of current visible lines
		rows: ; number of data rows
		widths: ; pixel width of each column (table option only)
		aligns: ; column aligns
		tab-levels: none ; tab stops (tree only)
		cols: 1 ; number of columns (> 1 table option only)
		picked: [] ; current selection(s)
		scroll: 0 ; scroll offset
		resize: make function! [] [; window size change(s)
			lines: to integer! size/y / sizes/line
			pane/2/show?: either rows > lines [
				scroll: max 0 min scroll rows - lines
				true
			] [
				scroll: 0
				false
			]
		]
		redraw: make function! [] [; data change(s)
			clear picked
			rows: either empty? data [0] [(length? data) / cols]
			resize
			pane/2/ratio: either zero? rows [1] [lines / rows]
			show self
		]
		selected: make function! [/local blk] [
			all [empty? picked return none] ; are any rows selected?
			if parent-face/type = 'tree [
				return either find options 'only [
					trim/head copy pick data first picked
				] [
					pick parent-face/.data-path first picked
				]
			]
			either any [find options 'multi parent-face/type = 'table] [
				all [rows = length? picked return data] ; are all rows selected?
				blk: copy []
				either cols = 1 [
					foreach row picked [insert tail blk pick data row]
				] [
					foreach row picked [
						repeat col cols [
							insert tail blk pick data -1 + row * cols + col
						]
					]
				]
				blk
			] [pick data first picked]
		]
		init: make function! [/local p] [
			;	remove XY span directives
			error? try [remove find span #X]
			error? try [remove find span #Y]
			;	calculate lines & rows
			lines: to integer! size/y / sizes/line
			rows: (length? data) / cols
			;	iterated line handler
			clear pane
			p: self
			insert pane make baseface [
				size: p/size
				span: p/span
				pane: make function! [face index /local col-offset clr] [
					either integer? index [
						if index <= min lines rows [
							line/offset/y: index - 1 * sizes/line
							line/size/x: size/x
							index: index + scroll
							either p/parent-face/type = 'table [
								col-offset: 0
								repeat i p/cols [
									line/pane/:i/offset/x: col-offset
									line/pane/:i/size/x: p/widths/:i - sizes/cell ; column gap
									all [
										p/pane/2/show?
										i = p/cols
										line/pane/:i/size/x: line/pane/:i/size/x + (p/size/x - p/pane/2/size/x - (line/pane/:i/offset/x + line/pane/:i/size/x))
									]
									line/pane/:i/text: form pick p/data index - 1 * cols + i
									line/pane/:i/font/color: either find picked index [colors/edit] [colors/text]
									col-offset: col-offset + pick widths i
								]
							] [
								line/text: form pick face/parent-face/data index
								line/font/color: either find picked index [colors/edit] [colors/text]
							]
							line/color: case [
								find picked index [colors/theme/3]
								all [even? index face/parent-face/type <> 'choose] [snow]
							]
							line/data: index
							line
						]
					] [to integer! index/y / sizes/line + 1]
				]
				text: ""
				line: make baseface [
					size: as-pair 0 sizes/line
					font: make default-font []
					para: either tab-levels [make default-para [tabs: tab-levels]] [none]
					feel: make default-feel [
						over: make function! [face into pos] [
							all [
								face/parent-face/parent-face/type = 'choose
								either into [insert clear picked data] [clear picked]
								show face
							]
						]
						engage: make function! [face act event /local p a b] [
							p: face/parent-face
							either event/double-click [
								all [act = 'down p/parent-face/action/on-dbl-click p/parent-face]
							] [
								if find [up alt-up] act [
									;	allow parent to get key events
									view*/focal-face: p
									view*/caret: tail p/text
									either find p/parent-face/options 'multi [
										;	unflag previous selections?
										unless any [event/control event/shift] [clear picked]
										either all [event/control find picked data] [
											remove find picked data
										] [
											unless find picked data [insert tail picked data]
										]
										;	shift highlight any gap between last two highlighted entries
										if all [event/shift 1 < length? picked] [
											clear next picked
											repeat i (max data first picked) - (a: min data first picked) + 1 [
												b: i + a - 1
												all [b <> first picked insert tail picked b]
											]
										]
									] [
										;	select new entry or deselect current
										either any [empty? picked data <> first picked] [
											insert clear picked data
										][
											clear picked
										]
									]
									;	perform action if any
									show p
									either act = 'up [
										p/parent-face/action/on-click p/parent-face
									] [
										p/parent-face/action/on-alt-click p/parent-face
									]
								]
							]
						]
					]
				]
			]
			;	table?
			if find options 'table [
				pane/1/line/pane: copy []
				repeat i cols [
					insert tail pane/1/line/pane make baseface [
						size: as-pair 0 sizes/line
						font: either 'left = aligns/:i [default-font] [make default-font [align: aligns/:i]]
					]
				]
			]
			;	vertical scroller
			insert tail pane make slider [
				offset: as-pair p/size/x - sizes/slider - 1 -1
				size: as-pair sizes/slider p/size/y 0
				span: case [none? p/span [none] find p/span #H [#H]]
				show?: either rows > lines [true] [false]
				action: make default-action [
					on-click: make function! [face] [
						scroll: to integer! rows - lines * data
						show face/parent-face
					]
				]
				ratio: either rows > 0 [lines / rows] [1]
			]
			pane/2/init
		]
	]

	;
	;	--- Load icon function
	;

	load-icon: make function! [
		size [pair!]
		file [file!]
		/local cache icon
	] [
		cache: []
		file: rejoin [%icons/ size %/ file]
		unless icon: select cache file [
			insert tail cache reduce [file icon: load file]
		]
		icon
	]

	;
	;	--- Choose function ---
	;

	choose: make function! [
		parent [object!] "Widget to appear in relation to"
		width [integer!] "Width in pixels"
		xy [pair!] "Offset of choice box"
		items [block!] "Block of items to display"
		/local popup result
	] [
		result: none
		popup: make face-iterator [
			type: 'choose
			offset: xy
			size: as-pair width sizes/line * min length? items to integer! parent/parent-face/size/y - xy/y / sizes/line
			color: colors/edit
			edge: default-edge
			data: items
			action: make default-action [
				on-click: make function! [face] [result: pick data first picked hide-popup]
			]
		]
		popup/init
		view*/caret: popup/pane/1/text
		view*/focal-face: popup/pane/1
		show-popup/window popup parent/parent-face
		wait []
		result
	]

	;
	;	--- Widget definitions ---
	;

	#include %widgets/anim.r
	#include %widgets/pill.r
	#include %widgets/area.r
	#include %widgets/arrow.r
	#include %widgets/bar.r
	#include %widgets/box.r
	#include %widgets/btn.r
	#include %widgets/button.r
	#include %widgets/calendar.r
	#include %widgets/chat.r
	#include %widgets/check.r
	#include %widgets/check-group.r
	#include %widgets/drop-list.r
	#include %widgets/edit-list.r
	#include %widgets/field.r
	#include %widgets/group-box.r
	#include %widgets/heading.r
	#include %widgets/icon.r
	#include %widgets/image.r
	#include %widgets/label.r
	#include %widgets/led.r
	#include %widgets/led-group.r
	#include %widgets/link.r
	#include %widgets/menu.r
	#include %widgets/panel.r
	#include %widgets/password.r
	#include %widgets/progress.r
	#include %widgets/radio-group.r
	#include %widgets/scroll-panel.r
	#include %widgets/sheet.r
	#include %widgets/slider.r
	#include %widgets/spinner.r
	#include %widgets/splitter.r
	#include %widgets/table.r
	#include %widgets/tab-panel.r
	#include %widgets/text.r
	#include %widgets/text-list.r
	#include %widgets/title-group.r
	#include %widgets/toggle.r
	#include %widgets/tool-bar.r
	#include %widgets/tree.r
]